home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol136 / bookmain.bas < prev    next >
Encoding:
BASIC Source File  |  1986-12-15  |  25.7 KB  |  522 lines
  1. 4000 COLOR 7,0: REM ****************************************************************************************************
  2. 4005 REM                    'BOOKMAIN' SUBROUTINE TO CREATE AND MAINTAIN THE 'ACCOUNTS' FILE
  3. 4010 REM  **************************************************************************************************************
  4. 4015 GOSUB 290  'OPEN ACCOUNTS FILE
  5. 4030 GOTO 4855     'DISPLAY CREATION/MAINTENANCE CHOICES
  6. 4035 REM  **************************************************************************************************************
  7. 4040 REM                        CREATE 'ACCOUNTS.REC' FILE AND INITIALIZE ALL FIELDS
  8. 4045 REM  **************************************************************************************************************
  9. 4050 TITLE$ = "OF CREATION RUN"
  10. 4055 COLOR 7,0: CLS
  11. 4060 PRINT IN$;"  Begin ACCOUNTS.REC File Creation"
  12. 4065 PRINT IN$;"  This program run will destroy any"
  13. 4070 PRINT IN$;"  previously created ACCOUNTS.REC File"
  14. 4075 PRINT IN$;: COLOR 0,7: PRINT "  Are you sure you want to continue?": COLOR 7,0
  15. 4077 PRINT IN$;: COLOR 0,7: PRINT "  Reply Y or N ";SPC(21): BEEP
  16. 4080 C$ = INKEY$: IF C$ = "" THEN GOTO 4080
  17. 4081 PRINT C$: COLOR 7,0
  18. 4082 IF C$ = "Y" OR C$ = "y" THEN GOTO 4085
  19. 4083 IF C$ = "N" OR C$ = "n" THEN GOTO 280   'RETURN TO MAIN MENU
  20. 4084 COLOR 31,0: PRINT IN$;"  I need a Y or N, try again ";:  GOTO 4080
  21. 4085 FOR REC% = 1 TO (M10% + M11%)
  22. 4090     GOSUB 4115  'INITIALIZE FIELDS TO ZEROS & BLANKS
  23. 4095     GOTO 4205
  24. 4100     REM  ----------------------------------------------------------------------------------------------------------
  25. 4105     REM                    SUBROUTINE TO INITIALIZE RECORD FIELDS TO ZEROS & BLANKS
  26. 4110     REM  ----------------------------------------------------------------------------------------------------------
  27. 4115     LSET B1$ = MKI$(0)
  28. 4120     LSET B2$ = MKI$(REC%)
  29. 4125     LSET F4$ = CHR$(255)
  30. 4130     LSET B3$ = SPACE$(4)
  31. 4135     LSET B4$ = MKI$(0)
  32. 4140     LSET B5$ = SPACE$(30)
  33. 4145     LSET B6$ = SPACE$(30)
  34. 4150     LSET B7$ = MKS$(0)
  35. 4155     LSET B8$ = SPACE$(8)
  36. 4160     LSET B9$ = MKD$(0)
  37. 4165     LSET B10$ = MKI$(0)
  38. 4170     LSET B11$ = SPACE$(1)
  39. 4175     LSET B12$ = MKD$(0)
  40. 4180     LSET B13$ = MKD$(0)
  41. 4185     LSET B14$ = MKD$(0)
  42. 4190     LSET B15$ = MKD$(0)
  43. 4195     RETURN
  44. 4200     REM  --MAKE NEXT-RECORD-NO.-POINTER OF LAST PRIME AREA RECORD POINT OUTSIDE FILE LIMITS------------------------
  45. 4205     IF REC% = M10% THEN LSET B16$ = MKI$(REC% + M11% + 1) ELSE LSET B16$ = MKI$(REC% + 1)
  46. 4210     REM  -------------------OVERFLOW AREA IS ONLY INITIALIZED ON ACCOUNTS FILE CREATION RUN------------------------
  47. 4215     IF REC% > M10% THEN GOTO 4640
  48. 4220     REM  ----------------------------------------------------------------------------------------------------------
  49. 4225     GOSUB 4250  'CREATE NEW ACCOUNT RECORD
  50. 4230     GOTO 4640   'PUT NEW ACCOUNT RECORD INTO ACCOUNTS.REC FILE
  51. 4235     REM  ----------------------------------------------------------------------------------------------------------
  52. 4240     REM          SUBROUTINE TO ENTER ACCOUNT IDENTIFICATION DATA - USED BY FILE CREATE, ADD & CHANGE RUNS
  53. 4245     REM  ----------------------------------------------------------------------------------------------------------
  54. 4250     IF REC% <> 1 THEN GOTO 4275
  55. 4255         LSET B5$ = "LAST UPDATED ON " + DATE$
  56. 4260         LSET B6$ = "TIME OF UPDATE " + TIME$
  57. 4265         LSET F4$ = "1"
  58. 4270         GOTO 4630
  59. 4275     CLS
  60. 4280     IF TITLE$<>"OF CREATION RUN" THEN GOTO 4400
  61. 4285     REM ---------THE FOLLOWING SECTION IS USED ON FILE CREATION RUN ONLY-------------------------------------------
  62. 4290      PRINT "  You may enter a higher Record Number"
  63. 4295      PRINT "  to reserve a block of records for"
  64. 4300      PRINT "  later insertion of NEW ACCOUNTS in"
  65. 4305      PRINT "  this record sequence."
  66. 4310      PRINT "                  OR"
  67. 4315      PRINT "  Press ENTER KEY ONLY to continue"
  68. 4320      PRINT "  with this Record Number ===> ";REC%
  69. 4325      COLOR 0,7: LOCATE ,32: Y = CSRLIN: X = POS(0)
  70. 4330      FIELDMAX% = 3: NUM.ONLY% = TRUE%: DEC.MINUS% = FALSE%: GOSUB 370
  71. 4335      IF DATU$ = "" THEN GOTO 4405
  72. 4340      KINT2% = VAL(DATU$)
  73. 4345      IF KINT2% > REC% THEN GOTO 4360
  74. 4350      COLOR 31,0: PRINT "  You must enter a Record Number"
  75. 4355      PRINT "  greater than ";REC%: GOTO 4325
  76. 4360      GOSUB 320  'PUT INITIALIZED RECORD TO ACCOUNTS FILE
  77. 4365      REC% = REC% + 1
  78. 4370      GOSUB 4115
  79. 4375      IF REC% = M10% THEN LSET B16$ = MKI$(REC% + M11% + 1) ELSE LSET B16$ = MKI$(REC% + 1)
  80. 4380      IF REC% > M10% THEN RETURN
  81. 4385      IF REC% = KINT2% THEN GOTO 4400
  82. 4390      GOTO 4360
  83. 4395      REM -------THE ABOVE SECTION IS USED ON FILE CREATION RUN ONLY------------------------------------------------
  84. 4400     PRINT: PRINT "  This is Record Number ";REC%
  85. 4405 DATU$ = STR$(KINT%)
  86. 4410 I = LEN(DATU$)
  87. 4415 IF I = 2 THEN DATU$ = "000" + RIGHT$(DATU$,1): GOTO 4435
  88. 4420 IF I = 3 THEN DATU$ = "00" + RIGHT$(DATU$,2): GOTO 4435
  89. 4425 IF I = 4 THEN DATU$ = "0" + RIGHT$(DATU$,3): GOTO 4435
  90. 4430 IF I = 5 THEN DATU$ = RIGHT$(DATU$,4)
  91. 4435     PRINT: PRINT "  The last record's Account No.:  ";DATU$
  92. 4440     PRINT "  To use the same Account No. on this"
  93. 4445     PRINT "  record, press ENTER KEY ONLY, else"
  94. 4450     PRINT "  enter the NEW Account Number.  ";: Y = CSRLIN: X = POS(0)
  95. 4455     FIELDMAX% = 4: NUM.ONLY% = TRUE%: DEC.MINUS% = FALSE%: GOSUB 370
  96. 4460     IF DATU$ = "" THEN DATU$ = MKI$(KINT%): GOTO 4480
  97. 4465     IF LEN(DATU$)<>4 THEN COLOR 31,0: PRINT "  Account is a 4 digit code, retry": COLOR 7,0: PRINT: GOTO 4440
  98. 4470     KINT% = VAL(DATU$)
  99. 4475     IF KINT% = 0 THEN COLOR 31,0: PRINT NOTNUM$:  COLOR 7,0: GOTO 4445
  100. 4480     LSET B1$ = MKI$(KINT%)
  101. 4485     IF ASC(F4$) = 255 THEN GOTO 4535
  102. 4490         PRINT: PRINT "  This Account's Major Description is:"
  103. 4495         PRINT: PRINT "    ";B5$
  104. 4500         PRINT: PRINT "  Enter a NEW Major Description or"
  105. 4505         PRINT "  Press ENTER KEY ONLY to leave as is."
  106. 4510         Y = CSRLIN: X = POS(0)
  107. 4515         X = X + 3    'ADJUST CURSOR COLUMN
  108. 4520         FIELDMAX% = 30: NUM.ONLY% = FALSE%: GOSUB 370
  109. 4525         IF DATU$ = "" THEN GOTO 4565
  110. 4530         GOTO 4560
  111. 4535     PRINT: PRINT "  Enter Major Description"
  112. 4540     Y = CSRLIN: X = POS(0)
  113. 4545     X = X + 3:       'ADJUST CURSOR COLUMN
  114. 4550     FIELDMAX% = 30: NUM.ONLY% = FALSE%: GOSUB 370
  115. 4555     IF DATU$ = "" THEN GOTO 4535
  116. 4560     LSET B5$ = DATU$
  117. 4565     IF ASC(F4$) = 255 THEN GOTO 4595
  118. 4570         PRINT: PRINT "  Supplemental Description is:"
  119. 4575         PRINT: PRINT "    ";B6$
  120. 4580         PRINT: PRINT "  Enter a NEW Suppl. Description or"
  121. 4585         PRINT "  Press ENTER KEY ONLY to leave as is."
  122. 4590         GOTO 4600
  123. 4595     PRINT: PRINT "  Enter Supplemental Description"
  124. 4600     Y = CSRLIN: X = POS(0)
  125. 4605     X = X + 3        'ADJUST CURSOR COLUMN
  126. 4610     FIELDMAX% = 30: NUM.ONLY% = FALSE%: GOSUB 370
  127. 4615     IF DATU$ = "" THEN GOTO 4625
  128. 4620     LSET B6$ = DATU$
  129. 4625     LSET F4$ = "1"
  130. 4630     RETURN
  131. 4635     REM  ----------------------END OF SUBROUTINE TO ENTER ACCOUNT IDENTIFICATION-----------------------------------
  132. 4640     GOSUB 320  'PUT INITIALIZED RECORD TO ACCOUNTS FILE
  133. 4645 NEXT REC%
  134. 4650 REM -------------------------------END OF FOR.....NEXT LOOP OF FILE CREATION RUN-----------------------------------
  135. 4655 CLS
  136. 4660 LOCATE 12,1
  137. 4665 PRINT "  ACCOUNTS.REC diskette file created"
  138. 4670 PRINT "  Audit listing is now printing"
  139. 4675     PAGENO% = 0
  140. 4680     LINECT% = 0
  141. 4685 FOR REC% = 1 TO (M10% + M11%)
  142. 4690     GOSUB 310  'GET ACCOUNTS FILE RECORD
  143. 4695     IF ASC(F4$) = 255 THEN GOTO 4750
  144. 4700     IF PAGENO% = 0 THEN GOSUB 360
  145. 4705     IF LINECT% > 58 THEN GOSUB 360
  146. 4710     LACTM% = CVI(B1$)
  147. 4715     LACTS% = CVI(B2$)
  148. 4720     LPRINT USING "####";LACTM%;
  149. 4725     LPRINT USING " ###";LACTS%;
  150. 4730     LPRINT TAB(19);B5$
  151. 4735     LPRINT TAB(19);B6$;TAB(50);"_______I________I__________I____I___I___________I_________I___________I_________"
  152. 4740     LPRINT
  153. 4745     LINECT% = LINECT% + 3
  154. 4750 NEXT REC%
  155. 4835 CLOSE: GOTO 280   'RETURN TO MAIN MENU
  156. 4840 REM  **************************************************************************************************************
  157. 4845 REM                          DISPLAY ACCOUNTS FILE MAINTENANCE MENU JOB CHOICES
  158. 4850 REM  **************************************************************************************************************
  159. 4855 CLS
  160. 4860 PRINT "  ACCOUNTS FILE CREATE/MAINTAIN CHOICES"
  161. 4865 PRINT
  162. 4870 PRINT "   1  Add a NEW Account Number"
  163. 4875 PRINT "   2  Change an Account's Data"
  164. 4880 PRINT "   3  Delete an Account Number"
  165. 4885 PRINT
  166. 4886 PRINT
  167. 4887 PRINT "   7  Create ACCOUNTS.REC File"
  168. 4888 PRINT
  169. 4890 PRINT "   9  Return to Main Menu"
  170. 4895 PRINT: COLOR 0,7: PRINT "   Enter Maintenance Choice Number. ";: Y = CSRLIN: X = POS(0)
  171. 4900 FIELDMAX% = 1: NUM.ONLY% = TRUE%: DEC.MINUS% = FALSE%: GOSUB 370
  172. 4905 IF DATU$="1" THEN GOTO 4950
  173. 4910 IF DATU$="2" THEN GOTO 6155
  174. 4915 IF DATU$="3" THEN GOTO 6330
  175. 4916 IF DATU$="7" THEN GOTO 4050
  176. 4920 IF DATU$="9" THEN CLOSE: GOTO 280
  177. 4925 COLOR 31,0: PRINT "  Valid codes are 1,2,3,7,9. Try again";
  178. 4930 GOTO 4895
  179. 4935 REM  **************************************************************************************************************
  180. 4940 REM                              SUBROUTINE TO ADD A NEW ACCOUNTS FILE RECORD
  181. 4945 REM  **************************************************************************************************************
  182. 4950 GOSUB 330  'UPDATE ACCOUNTS FILE CONTROL RECORD
  183. 4955 PAGENO% = 0
  184. 4960 LINECT% = 0
  185. 4965 TITLE$ = "OF ADDITIONS"
  186. 4970 GOSUB 360  'PRINT HEADING LINES FOR AUDIT LISTING
  187. 4975 ACTION$ = SPACE$(18)
  188. 4980 GOSUB 350  'PRINT THE FILE CONTROL RECORD
  189. 4985 CLS
  190. 4990 PRINT "  Enter NEW ACCOUNT'S Record Number or"
  191. 4995 PRINT "  Press ENTER KEY ONLY if done.";
  192. 5000 Y = CSRLIN: X = POS(0)
  193. 5005 FIELDMAX% = 3: NUM.ONLY% = TRUE%: DEC.MINUS% = FALSE%: GOSUB 370
  194. 5010 REC% = VAL(DATU$)
  195. 5015 IF REC% = 0 THEN GOTO 4855
  196. 5020 IF REC% < (M10% + M11% + 1) THEN GOTO 5050
  197. 5025     PRINT "  Record Number range is 1 to";
  198. 5030     KINT% = M10% + M11%
  199. 5035     PRINT USING " ####";KINT%
  200. 5040     COLOR 31,0: PRINT "  Enter a valid Record Number";
  201. 5045     GOTO 5000
  202. 5050 GOSUB 310  'GET ACCOUNTS FILE RECORD
  203. 5055 IF ASC(F4$) = 255 THEN GOTO 5090
  204. 5060     KINT% = CVI(B1$)
  205. 5065     COLOR 0,7: PRINT "  This record is in use by ACCOUNT"
  206. 5070     PRINT "  ";KINT%;" ";B5$
  207. 5075     PRINT "  See Audit Listing for an available"
  208. 5080     PRINT "  Record Number & enter it.";: COLOR 7,0
  209. 5085     GOTO 5000
  210. 5090 KINT% = 0  'INITIALIZE TO ZERO
  211. 5095 GOSUB 4250  'ENTER ACCOUNT DESCRIPTIONS
  212. 5100 REM  ------------ENTRY STATEMENT FOR 'ACCOUNT FILE CHANGES' SUBROUTINE---------------------------------------------
  213. 5105 CLS
  214. 5110 KINT% = CVI(B1$)
  215. 5115 PRINT "  This is Account No.: ";
  216. 5120 DATU$ = STR$(KINT%)
  217. 5125 I = LEN(DATU$)
  218. 5130 IF I = 2 THEN DATU$ = "000" + RIGHT$(DATU$,1): GOTO 5155
  219. 5135 IF I = 3 THEN DATU$ = "00" + RIGHT$(DATU$,2): GOTO 5155
  220. 5140 IF I = 4 THEN DATU$ = "0" + RIGHT$(DATU$,3): GOTO 5155
  221. 5145 IF I = 5 THEN DATU$ = RIGHT$(DATU$,4)
  222. 5155 PRINT DATU$;
  223. 5160 PRINT USING " ####";REC%
  224. 5165 PRINT: PRINT "      ";B5$: PRINT "      ";B6$
  225. 5170 IF (KINT% >= 300) AND (KINT% < 1000) THEN GOTO 5260   'NOT CASH OR EQUIVALENT ASSET ACCOUNTS
  226. 5175 IF (KINT% >= 2000) AND (KINT% < 4000) THEN GOTO 5260  'INCOME ACCOUNTS & NETWORTH ACCOUNTS
  227. 5180 PRINT: PRINT "  Enter PAMCHECK Payee Code and"
  228. 5185 PRINT "  Payee Rec. No. which references this"
  229. 5190 PRINT "  Account record, if applicable."
  230. 5195 PRINT
  231. 5200 PRINT "  PAMCHECK Payee Code is: ";B3$
  232. 5205 COLOR 0,7: PRINT "  Enter four periods to remove code or": PRINT "  Enter change, if any...";: Y = CSRLIN: X = POS(0)
  233. 5210 FIELDMAX% = 4: NUM.ONLY% = TRUE%: DEC.MINUS% = TRUE%: GOSUB 370
  234. 5215 IF DATU$ = "...." THEN LSET B3$ = "    ": GOTO 5225
  235. 5220 IF DATU$<>"" THEN LSET B3$ = DATU$
  236. 5225 KINT% = CVI(B4$)
  237. 5230 PRINT: PRINT: PRINT USING "  PAMCHECK Payee Rec. No.: ###";KINT%
  238. 5235 COLOR 0,7: PRINT "  Enter change, if any....";: Y = CSRLIN: X = POS(0)
  239. 5240 FIELDMAX% = 3: NUM.ONLY% = TRUE%: DEC.MINUS% = FALSE%: GOSUB 370
  240. 5245 IF DATU$ = "" THEN GOTO 5260
  241. 5250 KINT% = VAL(DATU$)
  242. 5255 LSET B4$ = MKI$(KINT%)
  243. 5260 CLS
  244. 5265 KINT% = CVI(B1$)
  245. 5270 PRINT "  This is Account No.: ";
  246. 5275 DATU$ = STR$(KINT%)
  247. 5280 I = LEN(DATU$)
  248. 5285 IF I = 2 THEN DATU$ = "000" + RIGHT$(DATU$,1): GOTO 5305
  249. 5290 IF I = 3 THEN DATU$ = "00" + RIGHT$(DATU$,2): GOTO 5305
  250. 5295 IF I = 4 THEN DATU$ = "0" + RIGHT$(DATU$,3): GOTO 5305
  251. 5300 IF I = 5 THEN DATU$ = RIGHT$(DATU$,4)
  252. 5305 PRINT DATU$;
  253. 5310 PRINT USING " ####";REC%
  254. 5315 PRINT: PRINT SPC(6);B5$: PRINT SPC(6);B6$
  255. 5320 PRINT
  256. 5325 PRINT "  You may skip to the data field you"
  257. 5330 PRINT "  wish to add/change by entering the"
  258. 5335 PRINT "  number code below, or enter"
  259. 5340 PRINT "  the letter code instead if adding or"
  260. 5345 PRINT "  changing THIS DATA FIELD ONLY."
  261. 5350 PRINT: PRINT "  1 or A = Units to 3 decimals"
  262. 5355 PRINT "  2 or B = Asset/Liability Origin Date"
  263. 5360 PRINT "  3 or C = Cost of Asset/Liability"
  264. 5365 PRINT "  4 or D = Asset Mos. Life Expectancy"
  265. 5370 PRINT "  5 or E = Deprec'tn/Current Value Code"
  266. 5375 PRINT "  6 or F = Cumulative Depr./Appr. Amt."
  267. 5380 PRINT "  7 or G = Debit Amount"
  268. 5385 PRINT "  8 or H = Credit Amount"
  269. 5390 PRINT "  9 or I = Salvage or Budget Amount"
  270. 5395 PRINT "       X = Exit. No Field Change/Add"
  271. 5400 PRINT: COLOR 0,7: PRINT "  Enter Code...";: Y = CSRLIN: X = POS(0)
  272. 5405 FIELDMAX% = 1: NUM.ONLY% = FALSE%: GOSUB 370
  273. 5410 B$ = DATU$
  274. 5415 IF B$ = "X" OR B$ = "x" THEN GOTO 5945  'EXIT, NO FIELD CHANGES OR ADDS
  275. 5420 IF B$ < "1" OR B$ > "I" THEN GOTO 5435
  276. 5425 IF B$ >= "A" THEN C$ = CHR$(ASC(B$) - 16): KODE = VAL(C$) ELSE KODE = VAL(B$)
  277. 5430 IF KODE > 0 AND KODE < 10 THEN GOTO 5440
  278. 5435     COLOR 31,0: PRINT "  Invalid code entered. Retry": GOTO 5400
  279. 5440 ON KODE GOTO 5450,5490,5530,5590,5635,5710,5765,5820,5885
  280. 5445 GOTO 5400
  281. 5450 KSP! = CVS(B7$)
  282. 5455 GOSUB 6555
  283. 5460 PRINT USING "  Units to 3 decimals:    #####.###";KSP!
  284. 5465 COLOR 0,7: PRINT "  Enter change, if any...";: Y = CSRLIN: X = POS(0)
  285. 5470 FIELDMAX% = 9: NUM.ONLY% = TRUE%: DEC.MINUS% = TRUE%: GOSUB 370
  286. 5475 IF DATU$ = "" THEN GOTO 5490
  287. 5480 KSP! = VAL(DATU$)
  288. 5485 LSET B7$ = MKS$(KSP!)
  289. 5490 IF B$ = "A" OR B$ = "a" THEN GOTO 5945
  290. 5495 GOSUB 6555
  291. 5500 PRINT "  Asset/Liability Origin Date ";B8$
  292. 5505 COLOR 0,7: PRINT "     Enter change, if any....";: Y = CSRLIN: X = POS(0)
  293. 5510 FIELDMAX% = 8: NUM.ONLY% = TRUE%: DEC.MINUS% = TRUE%: GOSUB 370
  294. 5515 IF DATU$ = "" THEN GOTO 5525
  295. 5520 LSET B8$ = DATU$
  296. 5525 IF B$ = "B" OR B$ = "b" THEN GOTO 5945
  297. 5530 KDP# = CVD(B9$)
  298. 5535 GOSUB 6555
  299. 5540 PRINT "  Cost of Asset/Liability:";
  300. 5545 PRINT USING " ######,.## ";KDP#
  301. 5550 COLOR 0,7: PRINT "  Enter change, if any.....";: Y = CSRLIN: X = POS(0)
  302. 5555 FIELDMAX% = 9: NUM.ONLY% = TRUE%: DEC.MINUS% = TRUE%: GOSUB 370
  303. 5560 IF DATU$ = "" THEN GOTO 5575
  304. 5565 KDP# = VAL(DATU$)
  305. 5570 LSET B9$ = MKD$(KDP#)
  306. 5575 IF B$ = "C" OR B$ = "c" THEN GOTO 5945
  307. 5580 KINT% = CVI(B1$)
  308. 5585 IF (KINT% >=1000) THEN GOTO 5765  'NEXT 3 FIELDS ARE FOR ASSETS ONLY
  309. 5590 GOSUB 6555
  310. 5595 KINT% = CVI(B10$)
  311. 5600 PRINT USING "  Asset's mos. life expectancy: ###";KINT%
  312. 5605 COLOR 0,7: PRINT "  Enter change, if any.........";: Y = CSRLIN: X = POS(0)
  313. 5610 FIELDMAX% = 3: NUM.ONLY% = TRUE%: DEC.MINUS% = TRUE%: GOSUB 370
  314. 5615 IF DATU$ = "" THEN GOTO 5630
  315. 5620 KINT% = VAL(DATU$)
  316. 5625 LSET B10$ = MKI$(KINT%)
  317. 5630 IF B$ = "D" OR B$ = "d" THEN GOTO 5945
  318. 5635 GOSUB 6555
  319. 5640 PRINT "  Depreciation code or"
  320. 5645 PRINT "    Current Value code is: ";B11$
  321. 5650 COLOR 0,7: PRINT "  Enter change, if any....";: Y = CSRLIN: X = POS(0)
  322. 5655 PRINT "[-]": COLOR 7,0
  323. 5660 LOCATE Y,X+1
  324. 5665 C$ = INKEY$:  IF C$ = "" THEN GOTO 5665
  325. 5670 IF C$ = CHR$(13) THEN GOTO 5705
  326. 5675 COLOR 0,7: PRINT C$: COLOR 7,0
  327. 5680 IF C$ = SPACE$(1) THEN GOTO 5700
  328. 5685 KINT% = VAL(C$)
  329. 5690 IF (KINT%>0) AND (KINT%<10) THEN GOTO 5700
  330. 5695 COLOR 31,0: PRINT "  Not valid Depr./Cur.Value code, retry";: GOTO 5665
  331. 5700 LSET B11$ = C$
  332. 5705 IF B$ = "E" OR B$ = "e" THEN GOTO 5945
  333. 5710 KDP# = CVD(B12$)
  334. 5715 GOSUB 6555
  335. 5720 PRINT USING "  Cumulative Depr./Appr.   ######,.##-";KDP#
  336. 5725 COLOR 0,7: PRINT "  Enter change, if any.....";: Y = CSRLIN: X = POS(0)
  337. 5730 FIELDMAX% = 10: NUM.ONLY% = TRUE%: DEC.MINUS% = TRUE%: GOSUB 370
  338. 5735 IF DATU$ = "" THEN GOTO 5760
  339. 5740 KDP# = VAL(DATU$)
  340. 5745 LOCATE Y,X+1: COLOR 0,7
  341. 5750 PRINT USING "#####,.##-";KDP#: COLOR 7,0
  342. 5755 LSET B12$ = MKD$(KDP#)
  343. 5760 IF B$ = "F" OR B$ = "f" THEN GOTO 5945
  344. 5765 KDP# = CVD(B13$)
  345. 5770 GOSUB 6555
  346. 5775 PRINT USING "      Debit  amount is: ######,.##-";KDP#
  347. 5780 COLOR 0,7: PRINT "  Enter change, if any..";: Y = CSRLIN: X = POS(0)
  348. 5785 FIELDMAX% = 10: NUM.ONLY% = TRUE%: DEC.MINUS% = TRUE%: GOSUB 370
  349. 5790 IF DATU$ = "" THEN GOTO 5815
  350. 5795 KDP# = VAL(DATU$)
  351. 5800 LOCATE Y,X+1: COLOR 0,7
  352. 5805 PRINT USING "#####,.##-";KDP#: COLOR 7,0
  353. 5810 LSET B13$ = MKD$(KDP#)
  354. 5815 IF B$ = "G" OR B$ = "g" THEN GOTO 5945
  355. 5820 KDP# = CVD(B14$)
  356. 5825 GOSUB 6555
  357. 5830 PRINT USING "      Credit amount is: ######,.##-";KDP#
  358. 5835 COLOR 0,7: PRINT "  Enter change, if any..";: Y = CSRLIN: X = POS(0)
  359. 5840 FIELDMAX% = 10: NUM.ONLY% = TRUE%: DEC.MINUS% = TRUE%: GOSUB 370
  360. 5845 IF DATU$ = "" THEN GOTO 5870
  361. 5850 KDP# = VAL(DATU$)
  362. 5855 LOCATE Y,X+1: COLOR 0,7
  363. 5860 PRINT USING "#####,.##-";KDP#: COLOR 7,0
  364. 5865 LSET B14$ = MKD$(KDP#)
  365. 5870 KINT% = CVI(B1$)
  366. 5875 IF KINT% > 999 AND KINT% < 3000 THEN GOTO 5945  'LIABILITY AND NET WORTH ACCOUNTS
  367. 5880 IF B$ = "H" OR B$ = "h" THEN GOTO 5945
  368. 5885 KDP# = CVD(B15$)
  369. 5890 GOSUB 6555
  370. 5895 PRINT "  Salvage Value for Fixed Assets or"
  371. 5900 PRINT "  Annual Budget for Expenses/Income:"
  372. 5905 PRINT USING "           Amount is:   ######,.##";KDP#
  373. 5910 COLOR 0,7: PRINT "  Enter change, if any..";: Y = CSRLIN: X = POS(0)
  374. 5915 FIELDMAX% = 10: NUM.ONLY% = TRUE%: DEC.MINUS% = TRUE%: GOSUB 370
  375. 5920 IF DATU$ = "" THEN GOTO 5945
  376. 5925 KDP# = VAL(DATU$)
  377. 5930 LOCATE Y,X+1: COLOR 0,7
  378. 5935 PRINT USING "#####,.##-";KDP#: COLOR 7,0
  379. 5940 LSET B15$ = MKD$(KDP#)
  380. 5945 GOSUB 320  'WRITE THE RECORD TO ACCOUNTS FILE
  381. 5950 GOSUB 350  'PRINT THE ACCOUNTS RECORD JUST WRITTEN TO ACCOUNTS FILE
  382. 5955 IF LINECT% > 58 THEN GOSUB 360  'TEST FOR FULL PAGE
  383. 5960 REM ----------------RETURN TO 'ACCOUNTS FILE CHANGES' SUBROUTINE---------------------------------------------------
  384. 5965 IF ACTION$ = SPACE$(18) THEN GOTO 6000   'ONLY NEW ACCOUNT ADDITIONS
  385. 5970 RETURN   'ONLY CHANGES TO ACCOUNTS REACH THIS STATEMENT
  386. 5975 REM  --------------------------------------------------------------------------------------------------------------
  387. 5980 REM  If the new Account Record just added to the ACCOUNTS FILE was placed in the OVERFLOW AREA, then the sequence number
  388. 5985 REM  chain (B16$ field) from the immediately preceding Account Record must be placed in the ADDED Account Record (B16$ field)
  389. 5990 REM  and the Record Number of the ADDED Account Record must be placed in the preceding Account Record's chain (B16$ field)
  390. 5995 REM  --------------------------------------------------------------------------------------------------------------
  391. 6000 IF REC% < (M10% + 1) THEN GOTO 6135
  392. 6005     CLS
  393. 6010     PRINT "  Record Number of Account just added"
  394. 6015     PRINT "  to ACCOUNTS FILE must be placed in"
  395. 6020     PRINT "  the Account Record which precedes it"
  396. 6025     PRINT "  IN SEQUENCE.  Enter the preceding"
  397. 6030     COLOR 0,7: PRINT "  Account's Record Number ===>";: Y = CSRLIN: X = POS(0)
  398. 6035 FIELDMAX% = 3: NUM.ONLY% = TRUE%: DEC.MINUS% = FALSE%: GOSUB 370
  399. 6040     IF DATU$ = "" THEN COLOR 31,0: PRINT "  RETRY":  GOTO 6010
  400. 6045     KINT% = VAL(DATU$)
  401. 6050     IF KINT% = 0 THEN COLOR 31,0: PRINT NOTNUM$:  GOTO 6010
  402. 6055     IF KINT% = REC% THEN COLOR 31,0: PRINT "  DO NOT ENTER added record's number":  GOTO 6010
  403. 6060     IF (KINT% > 0) AND (KINT% < (M10% + M11% + 1)) THEN GOTO 6085
  404. 6065         COLOR 0,7: PRINT "  Record Number range is 1 to";
  405. 6070         PRINT USING " ####";(M10% + M11%)
  406. 6075         COLOR 31,0: PRINT "  Enter a valid Record Number"
  407. 6080         GOTO 6010
  408. 6085     SVADDRS% = REC%
  409. 6090     REC% = KINT%
  410. 6095     GOSUB 310  'GET PRECEDING ACCOUNT FILE RECORD
  411. 6100     KINT% = CVI(B16$)  'FORWARD CHAIN OF PRECEDING ACCOUNT FILE RECORD
  412. 6105     LSET B16$ = MKI$(SVADDRS%)  'REPLACE FORWARD CHAIN WITH NEW ACCOUNTS RECORD NUMBER
  413. 6110     GOSUB 320  'PUT UPDATED PRECEDING ACCOUNT FILE RECORD
  414. 6115     REC% = SVADDRS%  'GET THE UPDATED ACCOUNT FILE RECORD
  415. 6120     GOSUB 310       'TO REPLACE ITS FORWARD CHAIN WITH THE CHAIN FROM THE PRECEDING ACCOUNT FILE RECORD
  416. 6125     LSET B16$ = MKI$(KINT%)
  417. 6130     GOSUB 320  'PUT UPDATED NEW ACCOUNT FILE RECORD
  418. 6135 GOTO 4985  'RETURN FOR NEXT ADDITION
  419. 6140 REM  **************************************************************************************************************
  420. 6145 REM                         SUBROUTINE TO CHANGE DATA IN THE ACCOUNTS FILE RECORDS
  421. 6150 REM  **************************************************************************************************************
  422. 6155 GOSUB 330  'UPDATE ACCOUNTS FILE CONTROL RECORD
  423. 6160 PAGENO% = 0
  424. 6165 LINECT% = 0
  425. 6170 TITLE$ = "OF CHANGES"
  426. 6175 GOSUB 360  'PRINT REPORT HEADING LINES
  427. 6180 GOSUB 350  'PRINT THE FILE CONTROL RECORD
  428. 6185 CLS
  429. 6190 PRINT "  Enter record number of Account you"
  430. 6195 PRINT "  are changing or press ENTER KEY ONLY"
  431. 6200 PRINT "  if there are no more changes. ";
  432. 6205 Y = CSRLIN: X = POS(0)
  433. 6210 FIELDMAX% = 3: NUM.ONLY% = TRUE%: DEC.MINUS% = FALSE%: GOSUB 370
  434. 6215 IF DATU$ = "" THEN GOTO 4855
  435. 6220 REC% = VAL(DATU$)
  436. 6225 IF REC% = 0 THEN PRINT NOTNUM$: GOTO 6205
  437. 6230 IF REC% < (M10% + M11% + 1) THEN GOTO 6260
  438. 6235     COLOR 0,7: PRINT "  Record number range is l to";
  439. 6240     KINT% = M10% + M11%
  440. 6245     PRINT USING " ####";KINT%
  441. 6250     COLOR 31,0: PRINT "  Enter a valid record number"
  442. 6255     GOTO 6205
  443. 6260 GOSUB 310  'GET ACCOUNT FILE RECORD
  444. 6265 IF ASC(F4$)<>255 THEN GOTO 6280
  445. 6270     COLOR 31,0: PRINT USING "  Record number #### is not used.";REC%
  446. 6275     PRINT "  Try again":  GOTO 6205
  447. 6280 ACTION$ = "BEFORE CHANGES    "
  448. 6285 GOSUB 350  'PRINT RECORD BEFORE CHANGES
  449. 6290 KINT% = CVI(B1$)
  450. 6295 GOSUB 4250  'ENTER ACCOUNT IDENT. DATA FIELDS
  451. 6300 ACTION$ = "AFTER CHANGES     "
  452. 6305 GOSUB 5105  'ENTRY STATEMENT FOR CHANGES IN THE ADD SUBROUTINE
  453. 6310 GOTO 6185  'PERFORM NEXT ACCOUNT FILE CHANGE
  454. 6315 REM  **************************************************************************************************************
  455. 6320 REM                   SUBROUTINE TO DELETE AN ACCOUNT NUMBER RECORD FROM THE ACCOUNTS FILE
  456. 6325 REM  **************************************************************************************************************
  457. 6330 GOSUB 330  'UPDATE ACCOUNTS FILE CONTROL RECORD
  458. 6335 PAGENO% = 0
  459. 6340 LINECT% = 0
  460. 6345 TITLE$ = "OF DELETIONS"
  461. 6350 GOSUB 360  'PRINT REPORT HEADING LINES
  462. 6355 GOSUB 350  'PRINT FILE CONTROL RECORD
  463. 6360 COLOR 7,0: CLS
  464. 6365 PRINT "  Enter record number of ACCOUNT you"
  465. 6370 PRINT "  are deleting or press ENTER KEY ONLY"
  466. 6375 PRINT "  when done. ";: Y = CSRLIN: X = POS(0)
  467. 6380 FIELDMAX% = 3: NUM.ONLY% = TRUE%: DEC.MINUS% = FALSE%: GOSUB 370
  468. 6385 IF DATU$ = "" THEN GOTO 4855
  469. 6390 REC% = VAL(DATU$)
  470. 6395 IF REC% = 0 THEN COLOR 31,0: PRINT NOTNUM$:  GOTO 6380
  471. 6400 IF REC% < (M10% + M11% + 1) THEN GOTO 6430
  472. 6405     COLOR 0,7: PRINT "  Record number range is 1 to";
  473. 6410     KINT% = M10% + M11%
  474. 6415     PRINT USING " ####";KINT%
  475. 6420     COLOR 31,0: PRINT "  Enter a valid record number"
  476. 6425     GOTO 6380
  477. 6430 GOSUB 310  'GET ACCOUNT FILE RECORD
  478. 6435 ACTION$ = "ACCOUNT DELETED   "
  479. 6440 GOSUB 350  'PRINT RECORD BEFORE DELETION
  480. 6445 GOSUB 4115  'INITIALIZE DELETED RECORD TO BLANKS & ZEROS
  481. 6450 GOSUB 320  'PUT INITIALIZED RECORD TO ACCOUNTS FILE
  482. 6455 REM ---------------------------------------------------------------------------------------------------------------
  483. 6460 REM  If an overflow area record is being deleted, then search the ACCOUNTS.REC File for the record which chains to
  484. 6465 REM  this overflow area deleted record and place the chaining record field (B16$) from the deleted record in the
  485. 6470 REM  (B16$) field of this record.
  486. 6475 REM ---------------------------------------------------------------------------------------------------------------
  487. 6480 IF REC% < (M10% + 1) THEN GOTO 6360  'NOT AN OVERFLOW AREA RECORD
  488. 6485 SVADDRS% = REC%: CHANE% = CVI(B16$)
  489. 6490 FOR REC% = 1 TO (M10% + M11%)
  490. 6495     GOSUB 310  'GET ACCOUNTS RECORD
  491. 6500     KINT% = CVI(B16$)
  492. 6505     IF SVADDRS% = KINT% THEN GOTO 6535
  493. 6510 NEXT REC%
  494. 6515     COLOR 31,0: PRINT "  Next Record Chaining Field in ERROR."
  495. 6520     PRINT "  Use PAM Reference Manual Chain Field"
  496. 6525     PRINT "  Correction Routine which must be run.": COLOR 7,0
  497. 6530     C$ = "": GOTO 380  'JOB CANCELLED
  498. 6535 LSET B16$ = MKI$(CHANE%)
  499. 6540 GOSUB 320  'PUT ACCOUNTS RECORD
  500. 6545 GOTO 6360  'PERFORM NEXT ACCOUNTS FILE DELETION
  501. 6550 REM  ------------------------------SUBROUTINE TO CLEAR SCREEN LINES 16-20------------------------------------------
  502. 6555 CLS
  503. 6560 KINT% = CVI(B1$)
  504. 6565 PRINT "  This is Account No.: ";
  505. 6570 DATU$ = STR$(KINT%)
  506. 6575 I = LEN(DATU$)
  507. 6580 IF I = 2 THEN DATU$ = "000" + RIGHT$(DATU$,1): GOTO 6600
  508. 6585 IF I = 3 THEN DATU$ = "00" + RIGHT$(DATU$,2): GOTO 6600
  509. 6590 IF I = 4 THEN DATU$ = "0" + RIGHT$(DATU$,3): GOTO 6600
  510. 6595 IF I = 5 THEN DATU$ = RIGHT$(DATU$,4)
  511. 6600 PRINT DATU$;
  512. 6605 PRINT USING " ####";REC%
  513. 6610 PRINT: PRINT "      ";B5$: PRINT "      ";B6$
  514. 6615 PRINT: PRINT
  515. 6620 PRINT "  For Account field displayed below,   "
  516. 6625 PRINT "  enter new data then press ENTER KEY  "
  517. 6630 PRINT "  or press ENTER KEY ONLY if unchanged."
  518. 6635 PRINT: PRINT
  519. 6640 RETURN
  520. 6645 REM ---------------------------------------------------------------------------------------------------------------
  521. 9000 GOTO 9000 'CHAIN MERGE AREA LAST STATEMENT
  522.